

; Graphics Object Class
; handles file loading, auto generation of degree-dependant bitmaps, animation timing


(load "utility.scm") ; for string-extract-number
(load "vector.scm")  ; for vector-copy



; Global pre-load of graphics
(define (graphics-cache)
  ; loop through all files in *graphics-folder*
  (for-each (lambda (filepath)
              (let* ([file            (path->string filepath)]
                     [basename-length (if-min (string-find-first file #\_) (string-find-first file #\.))])
                (when *debug* (display* "loading graphics \"" file "\""))
                (if (or (not basename-length) (= basename-length 0))
                    (when *debug* (display* " .. invalid filename"))
                    (begin
                      (let* ([basename (substring file 0 basename-length)]
                             [tag      (substring file (string-length basename))]
                             [frame  0]
                             [degree 0]
                             [auto-generate #f])
                        ; parse tag
                        (let graphics-load-parse-tag-loop ()
                          (when (and tag (not (string=? tag "")))
                            ; frame
                            (if (string=? "_f" (substring tag 0 2))
                                (set!-values (frame tag) (string-extract-number (substring tag 2)))
                                ; degree
                                (if (string=? "_d" (substring tag 0 2))
                                    (begin
                                      (set!-values (degree tag) (string-extract-number (substring tag 2)))
                                      (set! auto-generate #t))
                                    ; end, extension
                                    (if (string=? *resource-file-extension* (substring tag 0 (min (string-length tag) (string-length *resource-file-extension*))))
                                        (set! tag (substring tag (string-length *resource-file-extension*)))
                                        ; unrecognised
                                        (begin
                                          (when *debug* (display* " .. unrecognized tag \"" tag "\""))
                                          (set! tag #f)))))
                            (graphics-load-parse-tag-loop)))
                        (when tag
                          ; check cache
                          (let* ([entry (massoc basename *graphics*)]
                                 [frame-vec  (if entry                                               (mcdr entry)                 #f)]
                                 [degree-vec (if (and frame-vec (< frame (vector-length frame-vec))) (vector-ref frame-vec frame) #f)]
                                 [bitmap (make-object bitmap% (string-append *graphics-folder* file) 'unknown/mask)])
                            (when *debug* (display* " .. bitmap " (if (send bitmap ok?) "ok" "failed")))
                            ; create entry if necessary
                            (unless entry
                              (set! entry (mcons basename frame-vec))
                              (set! *graphics* (mcons entry *graphics*)))
                            ; (re)allocate frame-vec if necessary
                            (set! frame-vec (vector-allocate frame-vec frame #f))
                            (set-mcdr! entry frame-vec)
                            ; (re)allocate degree-vec if necessary
                            (set! degree-vec (vector-allocate degree-vec degree #f))
                            (vector-set! frame-vec frame degree-vec)
                            ; set bitmap
                            (vector-set! degree-vec degree bitmap)
                            ; auto generate
                            (when auto-generate
                              (when *debug* (display* " .. auto generating"))
                              (let ([auto-degree degree])
                                (for ([mirror (vector #f #t)])
                                  (when mirror (set! auto-degree (- (/ *num-degree-bitmaps* 2) degree)))
                                  (for ([flip (vector #f #t)])
                                    (when flip (set! auto-degree (rotate-in-range *num-degree-bitmaps* (- auto-degree))))
                                    (when (or (not (< auto-degree (vector-length degree-vec))) (not (vector-ref degree-vec auto-degree)))
                                      (set! degree-vec (vector-allocate degree-vec auto-degree #f))
                                      (vector-set! frame-vec frame degree-vec)
                                      (vector-set! degree-vec auto-degree (bitmap-mirror-flip bitmap mirror flip))))))))))))
                (when *debug* (display* "\n"))))
            (directory-list *graphics-folder*)))




; Graphics/Animation Base Class

(define graphics-object%
  (class object%
    
    ; PUBLIC VARIABLES
    (init-field [graphics-name #f]
                [frame-time #i1/30]
                [own-copy #f])
    ; PRIVATE VARIABLES
    (define frames #f)
    (define width  #f)
    (define height #f)
    (define current-frame  0)
    (define current-degree 0)
    (define frame-time-left #i0)
    

    ; GETTERS
    (define/public (get-width)  width)
    (define/public (get-height) height)
    
    
    
    ; Draw
    (define/public (draw dc x y)
      (let ([bitmap (vector-ref (vector-ref frames current-frame) current-degree)])
        (send dc
              draw-bitmap
              bitmap
              (- x (/ (send bitmap get-width ) 2))
              (- y (/ (send bitmap get-height) 2))
              'solid (new color%) ; ignored for color bitmaps
              (send bitmap get-loaded-mask))))
    
    
    ; Load Graphics
    (define/public (graphics-load)
      (when graphics-name
        (let ([lookup (massoc graphics-name *graphics*)])
          (if (not lookup)
              (when *debug* (display* "could not find graphics for \"" graphics-name "\"\n"))
              (begin
                (when *debug* (display* "looked up graphics for \"" graphics-name "\"\n"))
                ; set bitmaps
                (if (not own-copy)
                    (set! frames (mcdr lookup))
                    (begin
                      (set! frames (vector-copy (mcdr lookup)))
                      (vector-for-each (lambda (i e) (when e (vector-set! frames i (vector-copy e)))) (mcdr lookup))))
                ; set width and height to match first bitmap found
                (for ([degree-vec frames])
                  (for ([bitmap degree-vec])
                    (when (and bitmap (not (and width height)))
                      (set! width  (send (vector-ref degree-vec 0) get-width))
                      (set! height (send (vector-ref degree-vec 0) get-height))))))))))
        
    
    ; Anim Advance
    (define/public (anim-advance)
      (let ([ret #f])
        (set! frame-time-left (- frame-time-left *time-delta*))
        (let anim-advance-loop ()
          (when (< frame-time-left 0)
            (set! frame-time-left (+ frame-time-left frame-time))
            (set! current-frame (add1 current-frame))
            (if (> current-frame (sub1 (vector-length frames)))
                (begin (set! current-frame 0)
                       (set! ret 'restart))
                (unless ret (set! ret 'next)))
            (anim-advance-loop)))
        ret))
    
    
    ; Anim Degree
    (define/public (anim-degree degree)
      (let ([result (rotate-in-range 8 (inexact->exact (round (* *num-degree-bitmaps* degree 1/360))))]
            [degree-vec (vector-ref frames current-frame)])
        (when (and (< result (vector-length degree-vec)) (vector-ref degree-vec result))
          (set! current-degree result))))
    
    
    ; Mutate Frames
    (define/public (anim-mutate-frames op)
      (for ([frame-pos (in-range (vector-length frames))])
        (let ([degree-vec (vector-ref frames frame-pos)])
          (for ([degree-pos (in-range (vector-length degree-vec))])
            (when (vector-ref degree-vec degree-pos)
              (vector-set! degree-vec degree-pos (op (vector-ref degree-vec degree-pos))))))))
    
    
    ; Constructor/Initialization
    (super-new)
    (graphics-load)))


